home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / write_pict.pro < prev    next >
Text File  |  1997-07-08  |  12KB  |  323 lines
  1. ; $Id: write_pict.pro,v 1.8 1997/01/22 21:08:28 griz Exp $
  2. ;
  3. ; Copyright (c) 1990-1997, Research Systems, Inc.  All rights reserved.
  4. ;    Unauthorized reproduction prohibited.
  5.  
  6. pro write_pict_item, unit, data, key
  7. ;       procedure write
  8. ;       This procedure swaps bytes for short and long words on little endian
  9. ;       machines.
  10. common write_pict_rev, rev
  11.  
  12.    if (key eq 0) or (rev eq 0) then begin
  13.       writeu, unit, data
  14.       return
  15.    endif
  16.  
  17.    if (key eq 1) then begin
  18.          x = data
  19.          byteorder,x,/sswap
  20.          writeu, unit, x
  21.    endif else if (key eq 2) then begin
  22.          x = data
  23.          byteorder,x,/lswap
  24.          writeu, unit, x
  25.    endif else writeu, unit, data
  26. end
  27.  
  28. FUNCTION PackData, image
  29.  
  30. ;       Function PackData
  31. ;       This function is used by the WRITE_PICT user library routine and
  32. ;       it performs the Quickdraw style run length encoding for PICT
  33. ;       files.  Image is the unpacked data.  
  34.  
  35. imagesize = SIZE(image)
  36. IF (imagesize[0] NE 2) THEN MESSAGE, "non two dimensional array passed to pack"
  37. width = FIX(imagesize[1])
  38. height = FIX(imagesize[2])
  39.  
  40. retval = BYTARR((LONG(width) + 10L) * LONG(height), /NOZERO)
  41. retvalindex = 0L
  42. pack = bytarr(width * 1.5, /NOZERO)
  43. indexarray = lindgen(width)
  44.  
  45. FOR scanline = height - 1, 0, -1 DO BEGIN
  46.  
  47.   in = image[*,scanline]
  48.   IF width GT 250 THEN packindex = 2 ELSE packindex = 1
  49.  
  50.   runstart = WHERE((in EQ in[1:*]) AND (in EQ in[2:*]), found)
  51.   IF (found EQ 0) THEN runstart = width ELSE runstart = [runstart, width]
  52.  
  53.   inpind = 0
  54.   endrun = -1
  55.  
  56.   FOR i = 0,N_ELEMENTS(runstart)-1 DO BEGIN     ;For each run
  57.     IF (endrun LT runstart[i]) THEN BEGIN
  58.       WHILE inpind LT runstart[i] DO BEGIN      ;Send out the bytes before it
  59.         packlen = (runstart[i] - inpind) < 128  ;in 128 byte chunks
  60.         pack[packindex] = packlen-1
  61.         pack[packindex+1:packindex+packlen] = in[inpind:inpind+packlen-1]
  62.         packindex = packindex + packlen + 1
  63.         inpind = inpind + packlen
  64.       ENDWHILE
  65.       IF runstart[i] NE width THEN BEGIN
  66.         runinds = WHERE((WHERE(in[runstart[i]] EQ in[runstart[i]:*]) EQ $
  67.                       indexarray))
  68.         runsize = N_ELEMENTS(runinds)
  69.         WHILE (runsize NE 0) DO BEGIN
  70.           runlen = runsize < 128
  71.           pack[packindex] = 256 - (runlen - 1)
  72.           pack[packindex+1] = in[runstart[i]]
  73.           packindex = packindex + 2
  74.           inpind = inpind + runlen
  75.           endrun = inpind
  76.           runsize = runsize - runlen
  77.         ENDWHILE
  78.       ENDIF
  79.     ENDIF
  80.   ENDFOR
  81.  
  82.   IF WIDTH GT 250 THEN BEGIN
  83.     pack[0] = (packindex - 2) / 256
  84.     pack[1] = (packindex - 2) mod 256
  85.   ENDIF ELSE BEGIN
  86.     pack[0] = packindex - 1
  87.   ENDELSE
  88.  
  89.   retval[retvalindex:retvalindex + packindex - 1] = pack[0:packindex-1]
  90.   retvalindex = retvalindex + packindex
  91.  
  92. ENDFOR
  93.  
  94. RETURN, retval[0:retvalindex - 1]
  95.  
  96. END
  97. ;------------------------ end of PackData routine --------------------------
  98.   
  99.  
  100.   
  101.  
  102. PRO WRITE_PICT, FILE, IMAGE, R, G, B
  103.  
  104. ;+
  105. ; NAME:         WRITE_PICT
  106. ; PURPOSE:      Writes image files with the current color palette in the PICT
  107. ;               Version 2 Format.  This format is used by Apple Macintosh 
  108. ;               Computers.
  109. ; CATEGORY:     
  110. ; CALLING SEQUENCE:
  111. ;       WRITE_PICT, FILE                ;Writes contents of current window
  112. ;       WRITE_PICT, FILE, IMAGE         ;Writes given array
  113. ;       WRITE_PICT, FILE, IMAGE, R, G, B  ;Writes array w/given color table
  114. ; INPUTS:
  115. ;       FILE = Scalar string giving the name of the PICT file to write.
  116. ;       IMAGE = 2D matrix to be output.  If IMAGE is omitted,
  117. ;         the entire current window is read into an array and written
  118. ;         to the PICT file.
  119. ; OPTIONAL INPUT PARAMETERS:
  120. ;       R, G, B = The Red, Green, and Blue color vectors to be written
  121. ;               with IMAGE.  If not specified, the current color table is used
  122. ; OUTPUTS:
  123. ;       FILE contains the image in a PICT version 2 file format.  If color
  124. ;       vectors were supplied, they are used. Otherwise, the last color tables
  125. ;       established by LOADCT are used (If LOADCT hasn't been used
  126. ;       to establish color tables yet it is used to load the B/W tables.).
  127. ; SIDE EFFECTS:
  128. ;       If R, G, and B aren't supplied and LOADCT hasn't been called yet,
  129. ;       this routine uses LOADCT to load the B/W tables.
  130. ; RESTRICTIONS:
  131. ;       Only creates Version 2 PICT files.  Only works with 8-bit displays
  132. ; PROCEDURE:
  133. ;       Write out the header, size, and the following quickdraw opcodes:
  134. ;               Version, HeaderOp, DefHilite, Clip, and PackBitsRect
  135. ;       Then pack the image data using the QUICKDRAW PackBits
  136. ;       run length encoding algorithm.
  137. ;       Packing method:
  138. ;               Each line is preceeded by a byte if the image width
  139. ;               is less than 250 or a integer otherwise.  This prefix
  140. ;               tells how many bytes are in the packed line to follow.
  141. ;               The line following this length descriptor is made up of
  142. ;               a series of runs and data as follows:
  143. ;       - Runs
  144. ;               If there is a run, the high bit of the first byte is 
  145. ;               set and the other seven bits tell how many elements are
  146. ;               in the run.  The next byte is then the value of the run.
  147. ;               Runs can only be 128 bytes in length so longer runs are
  148. ;               broken up into smaller runs if they exceed 128 bytes.
  149. ;               The smallest run is three bytes.
  150. ;       - Data
  151. ;               If there are a series of image values that differ at least
  152. ;               every two bytes, they are written out after a byte that
  153. ;               describes how many dissimilar data bytes are to follow.
  154. ;               As with runs, the length of a run of data can not be 
  155. ;               longer than 128 without setting the high bit of the
  156. ;               length descriptor so long strings of data are broken up
  157. ;               into chunks 128 bytes or smaller.
  158. ; MODIFICATION HISTORY:
  159. ;       Written 16 November 1990, Steve Richards.
  160. ;       SMR, Aug 25, '92        Rewrote the packing routine and fixed bugs.
  161. ;       JIY, Mar 30, '92        added fix to work on Ultrix and VMS.
  162. ;       SMR, Oct 12, '93        Added changes suggested by Joe Gurman that
  163. ;                               prevented the clobbering of color vectors on
  164. ;                               exit from the routine.
  165. ;       SMR, Jan 12, '94        Added a case for OSF byte ordering, suggested
  166. ;                               by Joe Gurman.
  167. ;       DMS, Jun 24, 1994       Fixed byte ordering logic.
  168. ;                               Added code to clip image to # of colors-1
  169. ;-
  170.  
  171. common write_pict_rev, rev
  172.  
  173. i  = byte(1,0,2)                        ;Test byte ordering of this machine
  174. rev = i[0] eq 1b                        ;TRUE to reverse for little endian
  175.  
  176. ON_ERROR, 2                             ;Return to main level if error
  177.  
  178. n_params = N_PARAMS();                  ;Check the arguments
  179.  
  180. IF (n_params EQ 1) THEN BEGIN           ;if no image passed in,
  181.   n_params = 2                          ;Fake 2 param call
  182.   IMAGE = TVRD()                        ;Read screen
  183. ENDIF
  184.  
  185. IF ((n_params NE 2) AND (n_params NE 5)) THEN $         ;return error if args
  186.   MESSAGE, "usage: WRITE_PICT, file, [IMAGE], [r,g,b]"  ;were incorrect
  187.  
  188. ; If any color vectors are supplied, do they have right attributes ?
  189. IF (n_params EQ 5) THEN BEGIN
  190.   r_size = SIZE(r)
  191.   g_size = SIZE(g)
  192.   b_size = SIZE(b)
  193.   IF ( (r_size[0] + g_size[0] + b_size[0]) NE 3) THEN $
  194.     MESSAGE, "R, G, & B must all be 1D vectors."
  195.   IF ( (r_size[1] NE g_size[1]) OR (r_size[1] NE b_size[1]) ) THEN $
  196.     MESSAGE, "R, G, & B must all have the same length."
  197. ENDIF ELSE BEGIN
  198.   tvlct, r,g,b,/GET
  199. ENDELSE
  200.  
  201. r_mac = long(r) * 256L          ;macs use ints for
  202. g_mac = long(g) * 256L          ;color values so move
  203. b_mac = long(b) * 256L          ;the values up
  204.  
  205. arraysize = fix(SIZE(IMAGE))    ;make sure correct dimensions of image
  206. IF(arraysize[0] NE 2) THEN $    ;were used
  207.   MESSAGE, "IMAGE must be a two dimensional matrix."
  208.  
  209. if (!version.os EQ 'MacOS') then begin
  210.         OPENW, unit, FILE, /GET_LUN,/STREAM, $
  211.             MACTYPE = "PICT"            ;open the file for writing
  212. endif else begin
  213.         OPENW, unit, FILE, /GET_LUN,/STREAM     ;open the file for writing
  214. endelse
  215.  
  216. hdr = BYTARR(512)               ;pad the file with a 512 byte IMAGE
  217. write_pict_item, unit, hdr, 0   ;that contains nothing important
  218.  
  219. imagesize = 0                   ;integer padding for IMAGE size which
  220. write_pict_item, unit, imagesize,1      ;is ignored by version 2 PICT files
  221.  
  222. Rect = {rect, top:0, left:0, bottom:arraysize[2], right:arraysize[1]}
  223. write_pict_item, unit, Rect, 1
  224.  
  225. opcode = 17                             ;Version Opcode
  226. version = 2b                            ;This is a version 2 file
  227. lowbyte = 255b                          ;being written
  228.   write_pict_item, unit, opcode, 1
  229.   write_pict_item, unit, version, 0
  230.   write_pict_item, unit, lowbyte, 0
  231.  
  232. opcode = 3072                           ;HeaderOp Opcode
  233.   headerdata = BYTE([[255,255,255,255],bytarr(20)])
  234.   write_pict_item, unit, opcode, 1
  235.   write_pict_item, unit, headerdata, 0
  236.  
  237. opcode = 30                             ;DefHilite Opcode
  238.   write_pict_item, unit, opcode, 1
  239.  
  240. opcode = 1                              ;Clip Opcode
  241.   regionsize = 10
  242.   clipregion = Rect
  243.   write_pict_item, unit, opcode, 1
  244.   write_pict_item, unit, regionsize, 1
  245.   write_pict_item, unit, clipregion, 1
  246.  
  247. opcode = 152                            ;PackBitsRect Opcode
  248.   pixMap = {pixMapstr,  $
  249.                 rowBytes:fix(32768 + Rect.right),$      ;set high bit
  250.                 Boundtop:0,                     $
  251.                 Boundleft:0,                    $
  252.                 Boundbottom:Rect.bottom,        $
  253.                 Boundright:Rect.right,          $
  254.                 version:0,                      $
  255.                 packType:0,                     $
  256.                 packSize:0L,                    $
  257.                 hRes:4718592L,                  $
  258.                 vRes:4718592L,                  $
  259.                 pixelType:0,                    $
  260.                 pixelSize:8,                    $
  261.                 cmpCount:1,                     $
  262.                 cmpSize:8,                      $
  263.                 planeBytes:0L,                  $
  264.                 pmTable:0L,                     $
  265.                 pmReserved:0L}
  266.  
  267.   colorlistsize = n_elements(r_mac)
  268.   colorTable = {colorTablestr,  ctseed:1038L,           $
  269.                                 transIndex:0,           $
  270.                                 ctSize:FIX(colorlistsize)-1}
  271.  
  272.   colors = INTARR(4, colorlistsize)
  273.   colors[0,*] = INDGEN(colorlistsize)
  274.   colors[1,*] = r_mac
  275.   colors[2,*] = g_mac
  276.   colors[3,*] = b_mac
  277.  
  278.   srcRect = Rect
  279.   dstRect = Rect
  280.  
  281.   mode = 0
  282.  
  283.   imagedata = byte(IMAGE) < byte(colorlistsize-1)  ;Clip it
  284.   IF(Rect.right GE 8) THEN BEGIN                ;pack data
  285.     imagedata = PackData(imagedata)
  286.   ENDIF
  287.  
  288.   write_pict_item, unit, opcode, 1
  289.   write_pict_item, unit, pixmap.rowbytes, 1
  290.   write_pict_item, unit, pixmap.boundtop, 1
  291.   write_pict_item, unit, pixmap.boundleft, 1
  292.   write_pict_item, unit, pixmap.boundbottom, 1
  293.   write_pict_item, unit, pixmap.boundright, 1
  294.   write_pict_item, unit, pixmap.version, 1
  295.   write_pict_item, unit, pixmap.packtype, 1
  296.   write_pict_item, unit, pixmap.packsize, 1
  297.   write_pict_item, unit, pixmap.hres, 2
  298.   write_pict_item, unit, pixmap.vres, 2
  299.   write_pict_item, unit, pixmap.pixeltype, 1
  300.   write_pict_item, unit, pixmap.pixelsize, 1
  301.   write_pict_item, unit, pixmap.cmpcount, 1
  302.   write_pict_item, unit, pixmap.cmpsize, 1
  303.   write_pict_item, unit, pixmap.planebytes, 2
  304.   write_pict_item, unit, pixmap.pmtable, 2
  305.   write_pict_item, unit, pixmap.pmreserved, 2
  306.   write_pict_item, unit, colortable.ctseed, 2
  307.   write_pict_item, unit, colortable.transindex, 1
  308.   write_pict_item, unit, colortable.ctsize, 1
  309.   write_pict_item, unit, colors, 1
  310.   write_pict_item, unit, srcrect, 1
  311.   write_pict_item, unit, dstrect, 1
  312.   write_pict_item, unit, mode, 1
  313.   write_pict_item, unit, imagedata, 0 
  314.  
  315.   IF ((N_ELEMENTS(imagedata) MOD 2) NE 0) THEN $
  316.     write_pict_item, unit, 0B, 0
  317.  
  318.   write_pict_item, unit, 255, 1         ;EOF Opcode
  319.  
  320.   FREE_LUN, unit
  321.  
  322. END
  323.